home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: MegaDisc / MegaDisc 36 (1993-11)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).zip / MegaDisc 36 (1993-11)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).adf / ARexx / Chars / CharGrid next >
Text File  |  1993-09-15  |  8KB  |  235 lines
  1.  
  2.                /*  Character  Designer  */    
  3.                /*    by John Collett    */
  4.  
  5.     /* Make required libraries active */
  6.     lib.1 = 'rexxsupport.library' ; lib.2 = 'rexxarplib.library'
  7.     do i = 1 to 2
  8.      if ~show('l',lib.i) then check = addlib(lib.i,0,-30,0) 
  9.      end
  10.  
  11.     /* Create required ports and open window */
  12.     address AREXX '"call CreateHost(HO, PORT)"'    
  13.     if ~show('Ports','HO') then address command 'WaitForPort HO' 
  14.  
  15.     flags = 'WINDOWCLOSE+WINDOWDRAG'
  16.     idcmp = 'CLOSEWINDOW+MOUSEBUTTONS+GADGETUP'
  17.     call OpenWindow(HO,160,12,300,100,idcmp,flags,'Character Designer') 
  18.     call openport(PORT) ; call ActivateWindow(HO)
  19.     call ModifyHost(HO,MOUSEBUTTONS,'%l %b %x %y')
  20.     
  21.                   /*  S e t t i n g s  */
  22.     fileopen = 0 ; left = 50 ; top = 18 ; scale = 8
  23.     right = left + 8 * scale ; bottom = top + 8 * scale ; call Box()
  24.     g.1 = 'Show ' ; g.2 = 'Save ' ; g.3 = 'Clear' ; g.4 = 'Load '
  25.     g.5 = 'Help ' ; g.6 = 'Quit '
  26.     do i = 1 to 6
  27.       call AddGadget(HO,160,14*i,i,' ' || g.i || ' ','%l %b %d')
  28.       end
  29.     call pat(224,22,'-->')
  30.      
  31.                   /*   L o o p   */
  32.     do forever  
  33.      call waitpkt(PORT) ; p = getpkt(PORT)
  34.      if p ~== NULL() then                 
  35.       do                                  
  36.        i = getarg(p) ;  t = reply(p, 0)
  37.        parse var i class state rest
  38.        select
  39.          when i = 'CLOSEWINDOW' then signal 'finish'
  40.         
  41.          when class = 'MOUSEBUTTONS' then do
  42.            parse var i class state x y .
  43.            if x > left & x < right & y > top & y < bottom then do
  44.              if state = 'SELECTDOWN' then
  45.                do ; x1 = x ; y1 = y ;  end
  46.              else if state = 'SELECTUP' then
  47.                do ; x2 = x ; y2 = y ; call Cell(x1,y1,x2,y2) ; end
  48.              end
  49.            end
  50.         
  51.          when class = 'GADGETUP' then do
  52.            parse var i class gad . 
  53.            select
  54.              when gad = 1 then call ShowChar()
  55.              when gad = 2 then call SaveChar()
  56.              when gad = 3 then call ClearGrid()
  57.              when gad = 4 then call LoadChar()
  58.              when gad = 5 then call GetHelp()
  59.              when gad = 6 then signal 'finish'
  60.            otherwise
  61.            end             /* of select gad */
  62.          end               /* of class = GADGETUP */
  63.         
  64.          otherwise
  65.          end               /* of select          */
  66.        end                 /* of  'p ~== NULL()' */
  67.       end                  /* of 'do forever'    */
  68.     
  69.     finish:
  70.      if fileopen then cl = close(cf)  
  71.      call CloseWindow(HO)  
  72.      exit
  73.     
  74.              /*  C e l l   D i s p l a y  */
  75.     Cell:
  76.      cx1 = (arg(1) - left)%scale + 1 ; cy1 = (arg(2) - top)%(scale) +1
  77.      cx2 = (arg(3) - left)%scale + 1 ; cy2 = (arg(4) - top)%(scale) +1
  78.      both = (cx1 = cx2 & cy1 = cy2) ; neither = (cx1 ~= cx2 & cy1 ~= cy2)
  79.      select
  80.     
  81.     /* A single cell */
  82.       when both | neither then call DoCell(cx2,cy2)  
  83.     
  84.     /* A row */
  85.       when cx1 ~= cx2 then do
  86.        xmin = min(cx1,cx2) ; xmax = max(cx1,cx2)
  87.        do cell = xmin to xmax ; call DoCell(cell,cy2); end
  88.        end 
  89.     
  90.     /* A column */
  91.       when cy1 ~= cy2 then do
  92.        ymin = min(cy1,cy2) ; ymax = max(cy1,cy2)
  93.        do cell = ymin to ymax ; call DoCell(cx2,cell); end
  94.        end
  95.       otherwise
  96.       end 
  97.      return
  98.     
  99.     DoCell:
  100.      cx = arg(1) ; cy = arg(2)
  101.      if cx < 1 | cx > 8 | cy < 1 | cy > 8 then return
  102.      if c.cx.cy = 0 then co = 1 ; else co = 2
  103.      minx = left + scale * (cx-1) + 1 ; maxx = minx + scale - 2
  104.      miny = top + scale * (cy-1) + 1 ; maxy = miny + scale - 2
  105.      call AreaFill(co,minx,miny,maxx,maxy) ; call APen(1)
  106.      c.cx.cy = ~(c.cx.cy) ; call Update(cy)
  107.      return
  108.     
  109.     /*  Various functions */
  110.     Update:
  111.      packed = 0
  112.      do col = 1 to 8
  113.       if c.col.cy then packed = packed + 2**(8-col)
  114.      end
  115.      pstr = copies(' ',3 - length(packed)) || packed
  116.      call pat(120,19+cy*8,pstr)
  117.      return
  118.     /*  */    
  119.     pat:
  120.      if arg() = 4 then call APen(arg(4)) 
  121.      call Move(HO,arg(1),arg(2)) ; call Text(HO,arg(3))
  122.      return
  123.     /*  */  
  124.     APen: call SetAPen(HO,arg(1)) ; return
  125.     /*  */  
  126.     Frame:
  127.      parse arg lf,up,rt,bot . 
  128.      call Move(HO,lf,up) ; call Draw(HO,rt,up)    
  129.      call Move(HO,lf,bot) ; call Draw(HO,rt,bot)     
  130.      do u = 0 to 1 ; call Move(HO,rt-u,up+u) ; call Draw(HO,rt-u,bot) ; end 
  131.      do u = 0 to 1 ; call Move(HO,lf+u,bot-u) ; call Draw(HO,lf+u,up) ; end 
  132.      return
  133.     /*  */    
  134.     Box:
  135.       call AreaFill(2,left,top,right,bottom) ; call APen(3)
  136.       /* Show cells */
  137.       do i = 1 to 7
  138.        x = left + scale*i ; call Move(HO,x,top) ; call Draw(HO,x,bottom)
  139.        end
  140.       do i = 1 to 7
  141.        y = top + scale * i ; call Move(HO,left,y) ; call Draw(HO,right,y)
  142.        end
  143.       call APen(1) ; call Frame(left-1,top,right+1,bottom)
  144.     
  145.       /* Binary list - all zeros at start */
  146.       do r = 1 to 8 ; do col = 1 to 8 ; c.col.r = 0 ; end ; end
  147.      return
  148.     /*  */    
  149.     ShowChar:
  150.      call AreaFill(0,252,14,252 + 8,14 + 8) ; call APen(1)
  151.      do row = 1 to 8
  152.        do col = 1 to 8
  153.          if c.col.row then do
  154.           call Move(HO,252 + col,14 + row)
  155.           call Draw(HO,252 + col,14 + row) ; end
  156.           end 
  157.         end 
  158.       return
  159.     /*  */
  160.     ClearGrid:
  161.       call Box() ; call AreaFill(0,116,20,144,84) ; call APen(1)
  162.      return
  163.     /*  */
  164.     AreaFill:
  165.       call APen(arg(1)) ; call RectFill(HO,arg(2),arg(3),arg(4),arg(5))
  166.      return
  167.     
  168.               /*  S a v e   o r   L o a d  */
  169.     SaveChar:
  170.       if ~fileopen then call CharFile()
  171.       label = Request(190,112,'Character label','',,'Cancel')
  172.       if fileopen then do
  173.         if label ~= '' then do
  174.            s = seek(cf,0,'e') ; w = writeln(cf,label || BuildStr()) ; end
  175.          end
  176.      return
  177.     /* Data string */
  178.     BuildStr:
  179.      str = ''
  180.      do cy = 1 to 8 ; call Update(cy) ; str = str || ',' || packed ; end
  181.      return str
  182.  
  183.     LoadChar:
  184.     if ~fileopen then call CharFile()
  185.     label = Request(190,112,'Character label','',,'Cancel')
  186.     if label = '' then return
  187.     p = seek(cf,0,'b') ; found = 0
  188.     do until found | eof(cf)
  189.       t = readln(cf) ; parse var t lab ',' parms .
  190.       found = (lab = label)
  191.       end
  192.     if ~found then do
  193.       res = request(50,50,label 'not found',,'Okay') ; return ; end
  194.     
  195.       /* Read in 8 packed line values  */
  196.       parse var parms a.1 ',' a.2 ',' a.3 ',' a.4 ',' a.5 ',',
  197.                       a.6 ',' a.7 ',' a.8 .
  198.       do j = 1 to 8
  199.         if a.j = 0 then iterate
  200.         row = y + j 
  201.         /*  Convert to a line of eight 0s or 1s  */
  202.         octet = c2b(d2c(a.j))
  203.         do bit = 1 to 8
  204.         /*  Shade in those cells which are a 1  */
  205.           if substr(octet,bit,1) then call DoCell(bit,j)
  206.           end
  207.         end
  208.      return
  209.     
  210.     CharFile:
  211.       if ~fileopen then do
  212.         charfil = GetFile(160,100,,'chars','Character defs file')
  213.         if charfil ~= '' then do 
  214.           if exists(charfil) then op = open(cf,charfil,'a') 
  215.                              else op = open(cf,charfil,'w')
  216.           fileopen = 1 
  217.           end
  218.         end
  219.      return
  220.                     /*  H e l p  */
  221.      GetHelp:
  222.        t = ' Click or click/drag/release in the grid to change\',
  223.            'cells.  Use vertical or horizontal drags only.\\',
  224.            'GADGETS : \',
  225.            "'Show'  See your design at actual character size.\",
  226.            "'Save'  Store current character design in data file.\",
  227.            '        It just appends any new entry to the file.\',
  228.            "'Clear' Clean out the grid.\",
  229.            "'Load'  Edit a previously stored character. Uses\",
  230.            "        the same file as 'Save'.\",
  231.            "'Help'  This list."
  232.       mess = Request(50,96,t,,'Okay')
  233.       return
  234.                    /*  E n d  */
  235.